home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 4 / FM Towns Free Software Collection 4 - Disc 1.iso / fb386 / superedt / s_hex.bas < prev    next >
BASIC Source File  |  1991-10-18  |  6KB  |  145 lines
  1. 1000 SCREEN@ 0:CLS
  2. 1010 CLEAR  ,,,400000
  3. 1020 DIM HQ&(185),LAND&(3967),MASK(31,31)
  4. 1030 DIM DAT(1000),DAT1(1000)
  5. 1040 GOSUB *PALETTE_CHANGE
  6. 1050 GOSUB *LOAD
  7. 1060 GOSUB *MASK
  8. 1070 FOR Y=0 TO 31:FOR X=0 TO 31:PSET (X,Y),%MASK(X,Y):NEXT:NEXT
  9. 1080 GET@A(0,0)-(31,31),DAT
  10. 1090 FOR Y=0 TO 31:FOR X=0 TO 31:PSET (X,Y),%MASK(X,Y)*10:NEXT:NEXT
  11. 1100 GET@A(0,0)-(31,31),DAT1
  12. 1110 CLS
  13. 1120 FOR J=0 TO 7
  14. 1130  FOR I=0 TO 3
  15. 1140   IF J=7 AND I=3 GOTO 1160
  16. 1150   PUT@A(I*32+512,J*32)-(I*32+543,J*32+31),LAND&,,1,1,,128*(I+J*4)
  17. 1160  NEXT
  18. 1170 NEXT
  19. 1180 FOR I=0 TO 15
  20. 1190  LINE(I*24+10,270)-(I*24+25,285),PSET,%10,BF,%I
  21. 1200 NEXT
  22. 1210 SYMBOL(0,464),"COPY  CLEAR  SAVE",1,1,%10
  23. 1220 HEX=0:C=1:C1=255
  24. 1230 PUT@A(512,0)-(543,31),DAT,MATTE,,,0
  25. 1240 MOUSE 0:MOUSE 1,320,240,1
  26. 1250 GOSUB *PUT_HEX:GOSUB *COLOR
  27. 1260 *MAIN '-----------------------------------------------------------
  28. 1270 WHILE (MOUSE(2,0) OR MOUSE(2,1))=0:WEND
  29. 1280 X=MOUSE(0):Y=MOUSE(1)
  30. 1290 IF X<256 AND Y<256 THEN *LAND
  31. 1300 IF X>255 AND X<320 AND Y<48 THEN *HQ
  32. 1310 FOR I=0 TO 15
  33. 1320  IF X>I*24+9 AND X<I*24+25 AND Y>269 AND Y<286 C=I:GOSUB *COLOR
  34. 1330 NEXT
  35. 1340 IF X>511 AND Y<225 THEN *CHANGE
  36. 1350 IF X<33 AND Y>464 THEN *COPY
  37. 1360 IF X>47 AND X<89 AND Y>464 THEN *CLEAR
  38. 1370 IF X>103 AND X<137 AND Y>464 THEN *SAVE
  39. 1380 GOTO *MAIN
  40. 1390 *LAND '-----------------------------------------------------------
  41. 1400 X=X\8:Y=Y\8:IF MASK(X,Y)=1 THEN 1430
  42. 1410 LINE(X*8,Y*8)-(X*8+7,Y*8+7),PSET,%C,BF
  43. 1420 PSET((HEX MOD 4)*32+512+X,(HEX \ 4)*32+Y),%C
  44. 1430 GOTO *MAIN
  45. 1440 *HQ '-------------------------------------------------------------
  46. 1450 X=(X-256)\8:Y=Y\8
  47. 1460 LINE(X*8+256,Y*8)-(X*8+263,Y*8+7),PSET,%C,BF
  48. 1470 A$=RIGHT$("0000"+HEX$(HQ&(HEX*6+Y)),8)
  49. 1480 MID$(A$,((X+1) MOD 2)+(3-X\2)*2+1,1)=HEX$(C)
  50. 1490 IF VAL("&H"+LEFT$(A$,1))>7 HQ&(HEX*6+Y)=VAL("&H"+A$)-&HFFFFFFFF-1 ELSE HQ&(HEX*6+Y)=VAL("&H"+A$)
  51. 1500 GOTO *MAIN
  52. 1510 *CHANGE '---------------------------------------------------------
  53. 1520 X=(X-512)\32:Y=Y\32
  54. 1530 X1=(HEX MOD 4)*32+512:Y1=(HEX\4)*32
  55. 1540 PUT@A(X1,Y1)-(X1+31,Y1+31),DAT1,MATTE,,,0
  56. 1550 GET@A(X1,Y1)-(X1+31,Y1+31),LAND&,128*HEX
  57. 1560 PUT@A(X*32+512,Y*32)-(X*32+543,Y*32+31),DAT,MATTE,,,0
  58. 1570 HEX=X+Y*4
  59. 1580 GOSUB *PUT_HEX
  60. 1590 GOTO *MAIN
  61. 1600 *COPY '-----------------------------------------------------------
  62. 1610 SYMBOL(0,300),"ＦＲＯＭ",1,1,%10
  63. 1620 WHILE (MOUSE(2,0) OR MOUSE(2,1))=0:WEND
  64. 1630 X=MOUSE(0):Y=MOUSE(1)
  65. 1640 IF X<512 OR Y>224 IF MOUSE(2,1) GOTO *MAIN ELSE 1620
  66. 1650 X=(X-512)\32:Y=Y\32:FROM=X+Y*4
  67. 1660 PUT@A(64,+300)-(95,331),LAND&,,,,,128*FROM
  68. 1670 SYMBOL(0,332),"ＴＯ",1,1,%10
  69. 1680 WHILE (MOUSE(2,0) OR MOUSE(2,1)):WEND
  70. 1690 WHILE (MOUSE(2,0) OR MOUSE(2,1))=0:WEND
  71. 1700 X=MOUSE(0):Y=MOUSE(1)
  72. 1710 IF X<512 OR Y>224 IF MOUSE(2,1) GOTO *MAIN ELSE 1690
  73. 1720 X=(X-512)\32:Y=Y\32:T=X+Y*4
  74. 1730 PUT@A(64,332)-(95,363),LAND&,,,,,128*T
  75. 1740 FOR I=0 TO 127
  76. 1750   LAND&(128*T+I)=LAND&(128*FROM+I)
  77. 1760 NEXT
  78. 1770 FOR I=0 TO 5
  79. 1780   HQ&(6*T+I)=HQ&(6*FROM+I)
  80. 1790 NEXT
  81. 1800 PUT@A(X*32+512,Y*32)-(X*32+543,Y*32+31),LAND&,,,,,128*T
  82. 1810 LINE(0,300)-(99,363),PSET,%0,BF
  83. 1820 GOTO *MAIN
  84. 1830 *CLEAR '----------------------------------------------------------
  85. 1840 X1=HEX MOD 4:Y1=HEX\4
  86. 1850 FOR Y=0 TO 31
  87. 1860  FOR X=0 TO 31
  88. 1870   IF MASK(X,Y)=0 PSET(X+X1*32+512,Y+Y1*32),%C ELSE PSET(X+X1*32+512,Y+Y1*32),%10
  89. 1880  NEXT
  90. 1890 NEXT
  91. 1900 GET@A(X1*32+512,Y1*32)-(X1*32+543,Y1*32+31),LAND&,128*HEX
  92. 1910 GOSUB *PUT_HEX
  93. 1920 GOTO *MAIN
  94. 1930 END
  95. 1940 *PALETTE_CHANGE '-------------------------------------------------
  96. 1950 PALETTE  0,[  0,  0,  0]:PALETTE  1,[  0,  0,192]
  97. 1970 PALETTE  2,[  0,192,  0]:PALETTE  3,[192,  0,  0]
  98. 1990 PALETTE  4,[192,192,  0]:PALETTE  5,[  0,128,  0]
  99. 2010 PALETTE  6,[128,192,  0]:PALETTE  7,[255,  0,  0]
  100. 2030 PALETTE  8,[255,255,  0]:PALETTE  9,[255,  0,255]
  101. 2050 PALETTE 10,[255,255,255]:PALETTE 11,[  0,  0,  0]
  102. 2070 PALETTE 12,[  0,128,192]:PALETTE 13,[ 64, 64, 64]
  103. 2090 PALETTE 14,[128,128,128]:PALETTE 15,[128,128,  0]
  104. 2110 RETURN
  105. 2120 *PUT_HEX '--------------------------------------------------------
  106. 2130 PUT@A(0,0)-(31,31),LAND&,,8,8,,128*HEX
  107. 2140 PUT@A(256,0)-(263,5),HQ&,,8,8,,6*HEX
  108. 2150 RETURN
  109. 2160 *COLOR '----------------------------------------------------------
  110. 2170 IF C=C1 RETURN ELSE IF C1=255 THEN 2200
  111. 2180 LINE(C1*24+ 7,267)-(C1*24+28,288),PSET, %0,BF
  112. 2190 LINE(C1*24+10,270)-(C1*24+25,285),PSET,%10,BF,%C1
  113. 2200 LINE(C *24+ 7,267)-(C *24+28,288),PSET,%10,BF
  114. 2210 LINE(C *24+11,271)-(C *24+24,284),PSET, %C,BF
  115. 2220 C1=C
  116. 2230 RETURN
  117. 2240 *MASK '-----------------------------------------------------------
  118. 2250 FOR Y=0 TO 31
  119. 2260  READ A$
  120. 2270  FOR X=0 TO 7
  121. 2280  B=VAL(MID$(A$,X+1,1))
  122. 2290  IF B>7 MASK(X*4  ,Y)=1:B=B-8
  123. 2300  IF B>3 MASK(X*4+1,Y)=1:B=B-4
  124. 2310  IF B>1 MASK(X*4+2,Y)=1:B=B-2
  125. 2320  IF B>0 MASK(X*4+3,Y)=1:B=B-1
  126. 2330  NEXT
  127. 2340 NEXT
  128. 2350 DATA FFFE7FFF,FFF81FFF,FFE007FF,FF8001FF,FE00007F,F800001F,E0000007
  129. 2360 DATA 80000001,00000000,00000000,00000000,00000000,00000000,00000000
  130. 2370 DATA 00000000,00000000,00000000,00000000,00000000,00000000,00000000
  131. 2380 DATA 00000000,00000000,00000000,80000001,E0000007,F800001F,FE00007F
  132. 2390 DATA FF8001FF,FFE007FF,FFF81FFF,FFFE7FFF
  133. 2400 *LOAD '-----------------------------------------------------------
  134. 2410 LOAD@ "A:\HQ.DAT",HQ&
  135. 2420 LOAD@ "A:\LAND.DAT",LAND&
  136. 2430 RETURN
  137. 2440 *SAVE '-----------------------------------------------------------
  138. 2450 X1=(HEX MOD 4)*32+512:Y1=(HEX\4)*32
  139. 2460 PUT@A(X1,Y1)-(X1+31,Y1+31),DAT1,MATTE,,,0
  140. 2470 GET@A(X1,Y1)-(X1+31,Y1+31),LAND&,128*HEX
  141. 2480 PUT@A(X1,Y1)-(X1+31,Y1+31),DAT,MATTE,,,0
  142. 2490 SAVE@ "A:\HQ.DAT",HQ&
  143. 2500 SAVE@ "A:\LAND.DAT",LAND&
  144. 2510 GOTO *MAIN
  145.